home *** CD-ROM | disk | FTP | other *** search
/ Run Magazine ReRun 1988 September & October / rerun-1988-09-10a.d64 / flipper 34 (.txt) < prev    next >
Commodore BASIC  |  2022-09-20  |  5KB  |  154 lines
  1. 10 rem copyright 1988 francis saffell
  2. 20 poke52,32:poke56,32:clr:dims$(34),c(34,2),i,j,w,x,y,d,g,c,h
  3. 30 pn=1:po=1:t=1:rf=1:rs=1:a=1064:a1=53272:a2=54272:a3=a:a4=56576:a5=53281
  4. 40 b=128:b1=40:b2=999:l=1024:m=256:n=252:z=960
  5. 50 p=251:q=254:r=679:s=648:ch=32:f$="":g$="":g1$="":g2$="":r$=chr$(13)
  6. 60 printchr$(142)chr$(8):poke650,b:pokea5-1,0:pokea5,0:poke649,1
  7. 70 print"[147]after setting up, press \ keywait ....":gosub570
  8. 80 poke198,0:gosub1210
  9. 90 c=peek(a):ifc<bthenc=c+b:goto110
  10. 100 c=c-b
  11. 110 w=a+a2:d=peek(w)and15:pokew,3-t:pokea,c
  12. 120 getg$:ifg$=""then120
  13. 130 ifc>=bthenc=c-b:goto150
  14. 140 c=c+b
  15. 150 pokea,c:pokew,d:g=asc(g$):ifg=13theng=ch:goto400
  16. 160 ifg=92thengosub1420:goto80
  17. 170 if(g>31andg<b)org>160then370
  18. 180 ifa<1104andg=145then90
  19. 190 ifa>1983andg=17then90
  20. 200 ifa=a3andg=157then90
  21. 210 ifa=2023andg=29then90
  22. 220 ifg=145thena=a-b1:goto90
  23. 230 ifg=17thena=a+b1:goto90
  24. 240 ifg=157thena=a-1:goto90
  25. 250 ifg=29thena=a+1:goto90
  26. 260 ifg=20thengosub440:goto90
  27. 270 ifg=5thengosub1350:goto80
  28. 280 ifg=148thent=abs(t-1):goto80
  29. 290 ifg=141thench=peek(a):goto90
  30. 300 ifg=18thenof=b:goto90
  31. 310 ifg=146thenof=0:goto90
  32. 320 ifg=19thena=a3:goto90
  33. 330 ifg=147thengosub850:goto80
  34. 340 ifg<133org>140then90
  35. 350 ong-132gosub1070,1170,1140,470,1230,1310,880,950
  36. 360 goto80
  37. 370 ifg>191andg<224theng=g-b:goto390
  38. 380 if(g>159andg<192)or(g>63andg<96)theng=g-64
  39. 390 pokea,g+of:goto410
  40. 400 pokea,g
  41. 410 pokew,5:ifa<2023thena=a+t
  42. 420 goto90
  43. 430 rem delete*
  44. 440 pokea,32:ifa<>a3thena=a-1
  45. 450 return
  46. 460 rem flip*
  47. 470 pokes,144:gosub840:pokes,4:poke808,239
  48. 480 fori=rstorf:wait53265,b:x=c(i,0):y=c(i,1)::::::::::::::::::::::::
  49. 490 pokea4,x:pokea1,y:ford=0toh:nextd:getg$:ifg$=""then520
  50. 500 ifg$="+"thenh=h+25
  51. 510 ifg$="-"andh>24thenh=h-25
  52. 520 nexti:ifg$<>"[136]"then480
  53. 530 rem reset*
  54. 540 pokea4+2,peek(a4+2)or3:pokea4,199:pokea1,21:poke808,237
  55. 550 fori=0tor:next:return
  56. 560 rem set up*
  57. 570 poke56333,127:poke1,51:ss=53248:se=55040:de=20480:gosub1390
  58. 580 poke1,55:poke56333,129:d=0:fori=0to2:forj=0to15:ifi=0andj<8then630
  59. 590 ifi=1andj>3andj<6then630
  60. 600 ifi=2andj>3andj<8then630
  61. 610 d=d+1:c(d,0)=199-i:c(d,1)=j*16+4:c(d,2)=i*16384+j*l
  62. 620 pokes,c(d,2)/m:gosub1290:pokec(d,2)+39,32
  63. 630 nextj,i:pokes,192:gosub840
  64. 640 print"f1 - set page in # and fetch"
  65. 650 print"f2 - set flip range"
  66. 660 print"f3 - set page out #"
  67. 670 print"f4 - page # display on/off"
  68. 680 print"f5 - stash screen to page out #"
  69. 690 print"f6 - load a page set"
  70. 700 print"f7 - start/stop page-flipping"
  71. 710 print"    + slower"
  72. 720 print"    - faster"
  73. 730 print"f8 - save pages in flip range"
  74. 740 print" \ - return to editor/help"
  75. 750 print"ctrl/wht - remove white characters"
  76. 760 print"inst     - cursor advance on/off"
  77. 770 print"shft/rtn - hold character"
  78. 780 print"rtn      - place character":pokes,4:fori=rto759:readg:pokei,g:next
  79. 790 data165,1,41,254,133,1,169,0,168,177,251,133,254,165,1,9,1,133,1,96
  80. 800 data165,1,41,254,133,1,169,2,162,8,160,255,32,186,255,173,244,2,162,245
  81. 810 data160,2,32,189,255,173,240,2,133,251,173,241,2,133,252,169,251,174,242,2
  82. 820 data172,243,2,32,216,255,165,1,9,1,133,1,96,0,0,0,0,0,64,48,58
  83. 830 rem clear*
  84. 840 pokea5,15:print"[147]":pokea5,0:return
  85. 850 gosub1290:input"clear screen (y/n)";g$:ifg$="y"thengosub840
  86. 860 return
  87. 870 rem load*
  88. 880 gosub1290:input"load (y/n)";g$:ifg$<>"y"thenreturn
  89. 890 gosub1290:print""spc(18)f$:input"name of page set";f$:iff$=""then880
  90. 900 open3,8,3,"0:"+f$+".dir,s,r":input#3,g$,g1$:rs=val(g$):rf=val(g1$)
  91. 910 fori=rstorf:input#3,s$(i),g$,g1$,g2$:next:close3
  92. 920 fori=rstorf:gosub1290:print"loading page";i
  93. 930 open1,8,1,s$(i):poke780,0:sys65493:close1:next:return
  94. 940 rem save*
  95. 950 gosub1290:input"save pages (y/n)";g$:ifg$<>"y"thenreturn
  96. 960 gosub1290:print""spc(24)f$:input"set name (1 to 5 char)";f$
  97. 970 iff$=""orlen(f$)>5then950
  98. 980 open15,8,15,"s0:"+f$+"*":close15
  99. 990 open3,8,3,f$+".dir,s,w":print#3,str$(rs);r$;str$(rf);r$;:fori=rstorf
  100. 1000 gosub1290:print"saving page"i:g=c(i,2):d=g+1000
  101. 1010 g$=f$+"."+right$(str$(i),2):ifi<10theng$=f$+"."+right$(str$(i),1)
  102. 1020 y%=g/m:print#3,g$;r$;str$(c(i,0));r$;str$(c(i,1));r$;str$(y%);r$;
  103. 1030 y=len(g$):forj=1toy:poke759+j,asc(mid$(g$,j,1)):nextj
  104. 1040 poke756,y+3:poke753,g/m:poke752,g-(peek(753)*m)
  105. 1050 poke755,d/m:poke754,d-(peek(755)*m):sys699:nexti:close3:return
  106. 1060 rem fetch*
  107. 1070 gosub1290:print""spc(17)pn:input"page in # (1-34)";g$:gosub1490
  108. 1080 iffthen1070
  109. 1090 pn=val(g$):gosub840:print"fetching"pn:g=c(pn,2)
  110. 1100 ifpn<27thenss=g+b1:se=ss+z:de=a3:gosub1390:return
  111. 1110 fori=b1tob2:poken,(g+i)/m:pokep,g+i-peek(n)*m:sysr:pokel+i,peek(q):next
  112. 1120 return
  113. 1130 rem stash*
  114. 1140 ss=a3:se=ss+z:de=c(po,2)+b1:gosub1390:ifpo>rfthenrf=po
  115. 1150 pokes,144:gosub840:pokes,4:return
  116. 1160 rem page out*
  117. 1170 gosub1290:print""spc(18)po+1:input"page out # (1-34)";g$:gosub1490
  118. 1180 iffthen1170
  119. 1190 po=val(g$)
  120. 1200 rem heading*
  121. 1210 gosub1290:print"page in"pn" page out"po" range"rs"-"rf:return
  122. 1220 rem range*
  123. 1230 gosub1290:print""spc(19)rs:input"range start (1-34)";g$:gosub1490
  124. 1240 iffthen1230
  125. 1250 gosub1290:print""spc(20)rf:input"range finish (1-34)";g1$:gosub1490
  126. 1260 iffthen1250
  127. 1270 ifg1$<g$then1230
  128. 1280 rs=val(g$):rf=val(g1$):return
  129. 1290 print"                                       ":return
  130. 1300 rem page #*
  131. 1310 gosub1290:input"show page # (y/n)";g$:fori=1to34:pokes,c(i,2)/m:gosub1290
  132. 1320 ifg$="y"thenprint"page"str$(i),c(i,2)
  133. 1330 next:pokes,4:return
  134. 1340 rem clear*
  135. 1350 gosub1290:input"remove background (y/n)";g$:ifg$<>"y"thenreturn
  136. 1360 fori=a3to2023:g=peek(i+a2)and15:ifg=15thenpokei,32
  137. 1370 next:return
  138. 1380 rem move*
  139. 1390 c=se-ss:d=c+de:x%=c/m:x=c-m*x%:y%=(d-x)/m:y=d-m*y%-x
  140. 1400 w%=(se-x)/m:w=se-m*w%-x:poke781,x%+1:poke782,x:poke88,y:poke89,y%
  141. 1410 poke90,w:poke91,w%:sys41964:return
  142. 1420 rem help*
  143. 1430 poke808,239:ss=a3:se=ss+z:de=50216:gosub1390:ss=55336:se=ss+z:de=51213
  144. 1440 gosub1390:pokes,144:gosub840:pokes,4:ss=49192:se=ss+z:de=a3:gosub1390
  145. 1450 getg$:ifg$<>"\"then1450
  146. 1460 ss=50216:se=ss+z:de=a3:gosub1390
  147. 1470 ss=51213:se=ss+z:de=55336:gosub1390:poke808,237:return
  148. 1480 rem check*
  149. 1490 f=0:c=len(g$):x=asc(left$(g$,1)):y=asc(right$(g$,1)):ifc>2thenf=-1
  150. 1500 ifc=2andx>51thenf=-1
  151. 1510 ifx=51and(y<48ory>52)thenf=-1
  152. 1520 ifx<49orx>57ory<48ory>57thenf=-1
  153. 1530 return
  154.